\				=================================
\						Shared libraries
\				=================================


(*
	Usage:

	LIBRARY myLib

	LIBCALL myCall { parm1 parm2 %fparm1 -- res1 }


	The old syntax (Mops 3.2) will still be supported for a while:
	
	1  1 1 1 3  extern  myLib  myCall
	
	or for a floating routine:
	
	1 kFloat or  1 kFloat or  1 kFloat or  2  extern myOtherLib  myFloatGizmo

	defined as:

	EXTERN <lib_name> <call_name>
			( #result_cells #parm1_cells ... #parmN_cells N -- )

*)

: ADD_CASE_SENSITIVE_NAME
	bl word
	count  1+ #align4  ++> CDP
	drop
;

: LIBRARY  { \	svCaseFlg sv-in addr len ^len-byte  name_len -- }
	?exec
	>in @  -> sv-in		\ so we can read the name again case-sensitively

\ if we've already defined it as a library, and it's currently
\  FINDable, we don't need to define it again here.

	defined?
	IF	2- w@  $ BF0B =  ?EXIT
	ELSE
		drop
	THEN

	sv-in  >in !				\ get name again for header
	header  $ BF0B0000  code,	\  $BF0B = handler code for LIBRARY,
								\   plus alignment

	DP  0 ,						\ put 0 in data area - means no connID yet
	relocCode,					\ and reloc pointer to there in code area
	
	sv-in  >in !				\ now we have to get the name again, case-sensitively
	add_case_sensitive_name		\  this time, and just add it to the code area.  We'll
								\  use this when we connect to the library.
;



\ EXTERN <lib_name> <call_name>
\		( #result_cells #parm1_cells ... #parmN_cells N -- )

\ Some of this is a bit like MAC_EXTERN above, and some a bit
\  like SYSCALL, but then it's a bit different too, so I won't
\  try to factor bits out - it's trickier than it looks.


: EXTERN  ( result-info parm-info #parms )
		{ \ #parms #parm_cells #res_cells #fparms #fres mask ^lib ^info sv_in -- }

	-> #parms

	0 -> #parm_cells  0 -> #fparms  0 -> #fres  0 -> mask
	0 -> #res_cells

	#parms
	IF
		#parms FOR
	
		(*	#cells in next parm.  If the hi byte is set, that means
			it's floating point - in that case we count up the number of 
			floating parms (these have to  be put in the FPRs for the call), 
			and set the corresponding mask bit so that the corresponding 
			GPRs will get a dummy value.  This calling convention is a bit 
			crazy, but we're stuck with it.  Remember as the numbers have 
			been pushed onto the stack, we're going from the last parm 
			backwards.  So i in this FOR loop gives us the real parm# 
			starting from zero.
		*)		
			dup $ FF00 and
			IF				\ it's floating
				1 ++> #fparms
				drop  2		\ an FP parm is always 8 bytes = 2 cells
				mask 2 >>  $ C000 or  -> mask	\ mask 2 dummy GPRs here
			ELSE
				mask 1 >>  -> mask				\ normal GPR cell - no mask bit
			THEN
			++> #parm_cells
	
		NEXT
	THEN

( result-info )
	dup $ FF00 and
	IF								\ PPC result is floating - so no integer result
		1 -> #fres  drop 0
	THEN							\ otherwise there's no floating result

	-> #res_cells			\ number of result integer cells
	
	defined?				\ get library name
	NIF  abort" library name not defined"  THEN
	-> ^lib
	^lib 2- w@  $ BF0B <>  abort" that must be a library name"

	>in @  -> sv_in

\ now, if we've already defined it as an EXTERN and it's currently
\  FINDable, we don't need to define it again here.

	defined?
	IF		2- w@  $ BF01 =  ?EXIT
	ELSE	drop
	THEN

	sv_in  >in !
	
	header  $ BF01  codeW,		\ $BF01 = handler code for syscall/extern

	#parm_cells codeC,			\ 1 byte # parm cells
	#res_cells codeC,			\ 1 byte # result cells
	#fparms  codeC,				\ 1 byte # FP parms (in FPRs)
	#fres  codeC,				\ 1 byte # FP results (in FPRs)
	mask  codeW,

	DP  nilP ,					\ put nilP in data area - means not resolved yet
	relocCode,					\ and reloc pointer to there in code area
	^lib  relocCode,			\ and reloc ptr to lib
	
	sv_in  >in !				\ now we have to get the name again, case-sensitively
	add_case_sensitive_name		\  this time, and just add it to the code area.  We'll
								\  use this when we resolve the symbol.
;


\	======================  LIBCALL  ======================

	0	value	#parm_cells		\ these values are used by declare_call
	0	value	#fparms			\  which handles shared library entries.
	0	value	#fres			\ We set them here, but they'll be ignored
	0	value	mask			\  unless we're processing a declare_call.
	0	value	#res_cells
	0	value	lib_addr


: (find_lib)  { xt dummy \ addr procInfo -- }

	xt 2- w@ $ BF0B <>  ?EXIT	\ out if this isn't a library
	true -> endTrav?
	xt -> lib_addr
;


: find_lib
	0 -> lib_addr
	['] (find_lib)  0  trav  ;


: 1parm
	firstChr  & % =
	IF		\ it's floating
		1 ++> #fparms
		mask 2 >>  $ C000 or  -> mask	\ mask 2 dummy GPRs here
		2					\ an FP parm is always 8 bytes = 2 cells
	ELSE
		mask 1 >>  -> mask				\ normal GPR cell - no mask bit
		1					\ an integer parm is 1 cell
	THEN
	++> #parm_cells
;

(*
: gobble_to_}
	BEGIN
		firstChr  & }  <>
	WHILE
		Mword drop
	REPEAT
;
*)

: LIBCALL  { \ sv_in -- }

	0 -> #parm_cells  0 -> #fparms  0 -> #fres  0 -> mask
	0 -> #res_cells

	>in @  -> sv_in

\ now, if we've already defined it as an LIBCALL and it's currently
\  FINDable, we don't need to define it again here, but just skip
\  to }.

	defined?
	IF		2- w@  $ BF01 =
			IF  gobble_to_}  EXIT  THEN
	ELSE	drop
	THEN

	sv_in  >in !
	
	header  $ BF010000  code,		\ $BF01 = handler code for syscall/libcall
			\ Note, we have to leave CDP aligned so Mword ... firstChr will
			\  work!  We subtract 2 back off CDP below.

	Mword drop  firstChr & { <>  ?error 218
	
	BEGIN						\ Loop to process parms
		Mword drop firstChr  & -  <>			\ look for --
	WHILE
		firstChr  & } =  ?error 111
		1parm
	REPEAT

\ Finally we'll gobble input until }.  But we also need to check 
\  if a % comes first, as that's the way we declare a floating 
\  result for declare_call.  If we don't get a %, we assume an 
\  integer result.

	Mword drop  firstChr  & % =
	IF		1 -> #fres
			0
	ELSE	firstChr & } <>  negate		\ no result -> 0
										\ otherwise -> 1
	THEN
	-> #res_cells		\ number of integer result cells

	gobble_to_}

\ Now, what's the last-defined library?

	find_lib
	lib_addr 0= ?error 217		\ LIBRARY must be declared earlier

	2 --> CDP
	#parm_cells codeC,			\ 1 byte # parm cells
	#res_cells codeC,			\ 1 byte # result cells
	#fparms  codeC,				\ 1 byte # FP parms (in FPRs)
	#fres  codeC,				\ 1 byte # FP results (in FPRs)
	mask  codeW,

	DP  nilP ,					\ put nilP in data area - means not resolved yet
	relocCode,					\ and reloc pointer to there in code area
	lib_addr  relocCode,		\ and reloc ptr to lib
	
	sv_in  >in !				\ now we have to get the name again, case-sensitively
	add_case_sensitive_name		\  this time, and just add it to the code area.  We'll
								\  use this when we resolve the symbol.
;


\	====================== :ENTRY ======================

(*	We use :ENTRY for the exported entry points for a shared library.
	:ENTRY is rather like :, but sets the entry? flag because the named
	parms can go into different regs.  It also gets a different handler
	code ($BE05) so that any callers will know about the different
	parameter rules, and also so we can TRAV for exported entries at PEF
	time to set up the exported symbols.
*)


(* ***** now in zObjInit.

:ppc_code :entry_code
	rOSSP	-256	rOSSP	stwu,
	RTOC	20		rOSSP	stw,
	r13		100		rOSSP	stw,
	r14		104		rOSSP	stw,
	r15		108		rOSSP	stw,
	r16		112		rOSSP	stw,
	r17		116		rOSSP	stw,
	r18		120		rOSSP	stw,
	r19		124		rOSSP	stw,

	r13		104		rTOC	lwz,
	r14		108		rTOC	lwz,
	r15		112		rTOC	lwz,
	r16		116		rTOC	lwz,
	r17		120		rTOC	lwz,
	r18		124		rTOC	lwz,
	r19		128		rTOC	lwz,
;ppc_code

:ppc_code ;entry_code
	r13		100		rOSSP	lwz,
	r14		104		rOSSP	lwz,
	r15		108		rOSSP	lwz,
	r16		112		rOSSP	lwz,
	r17		116		rOSSP	lwz,
	r18		120		rOSSP	lwz,
	r19		124		rOSSP	lwz,
	rOSSP	0		rOSSP	lwz,		\ take down frame
							blr,

;ppc_code

***** *)


: :ENTRY  { \ sv_in -- }
	>in @  -> sv_in
	code_align
	$ BF0C0000 code,			\ marker for case sensitive name
	add_case_sensitive_name
	sv_in  >in !				\ now we have to get the name again
								\  for a normal colon-style header
	postpone :
	true -> entry?
	false -> leaf?				\ :entry never uses our leaf call protocol
	$ BE05  latest name> 2- w!
	drop 307					\ use our own security marker
;		immediate


: ;ENTRY
	307 ?defn
	300  postpone ;
	4 --> CDP					\ delete the blr

	['] ;entry_code 2+  CDP  36  aligned_move
	36 ++> CDP
	
	['] :entry_code 2+
	curr-def
	72  aligned_move
;		immediate